home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 2000 August: Tool Chest / Dev.CD Aug 00 TC Disk 2.toast / pc / sample code / printing / stylemap / stylemap.p < prev    next >
Encoding:
Text File  |  2000-06-23  |  5.6 KB  |  206 lines
  1. {
  2.     File:        StyleMap.p
  3.  
  4.     Contains:    Yet another code illustration for the Q&A on "intrinsic styles of a PostScript 
  5.                 font" in  d e v e l o p, Summer 1991, this time in my mother language.
  6.  
  7.                 For the sake of simplicity, the font "Times" and the size 36 are hardcoded, and
  8.                 the snippet assumes a "Times" FOND can be found in the system. Of course, the 
  9.                 output looks best if TrueType is present!
  10.  
  11.  
  12.     Written by: Joseph Maurer    
  13.  
  14.     Copyright:    Copyright © 1991-1999 by Apple Computer, Inc., All Rights Reserved.
  15.  
  16.                 You may incorporate this Apple sample source code into your program(s) without
  17.                 restriction. This Apple sample source code has been provided "AS IS" and the
  18.                 responsibility for its operation is yours. You are not permitted to redistribute
  19.                 this Apple sample source code as "Apple sample source code" after having made
  20.                 changes. If you're going to re-distribute the source, we require that you make
  21.                 it clear in the source that the code was descended from Apple sample source
  22.                 code, but that you've made changes.
  23.  
  24.     Change History (most recent first):
  25.                 7/26/1999    Karl Groethe    Updated for Metrowerks Codewarror Pro 2.1
  26.                 
  27.  
  28. }
  29. program StyleMap;
  30.     uses
  31.         Windows,Quickdraw,Fonts,Events,Menus,TextEdit,Dialogs,Resources;
  32.     var
  33.         gWP: WindowPtr;
  34.  
  35.  
  36. {------------------------------------------------}
  37.     procedure InitMac;
  38.     begin
  39.         InitGraf(@qd.thePort);
  40.         InitFonts;
  41.         FlushEvents(everyEvent, 0);
  42.         InitWindows;
  43.         InitMenus;
  44.         TEInit;
  45.         InitDialogs(nil);
  46.         InitCursor;
  47.     end;
  48.  
  49. {------------------------------------------------}
  50.     procedure InitApp;
  51.         var
  52.             bounds: Rect;
  53.     begin
  54.         SetRect(bounds, 0, 0, 480, 290);
  55.         gWP := NewWindow(nil, bounds, 'Click Mouse to Continue', false, documentProc, WindowPtr(-1), false, 0);
  56.         SetPort(gWP);
  57.         MoveWindow(gWP, 10, 50, true);
  58.         ShowWindow(gWP);
  59.     end;
  60.  
  61. {------------------------------------------------}
  62.     procedure WaitForButton;
  63.         var
  64.             evt: EventRecord;
  65.             done: Boolean;
  66.     begin
  67.         done := false;
  68.         repeat
  69.             SystemTask;
  70.             if GetNextEvent(keyDownMask + mDownMask, evt) then
  71.                 done := (evt.what = mouseDown);
  72.         until done;
  73.     end;
  74.  
  75. {========================================}
  76.     function CompressStyle (aStyle: Style): Integer;  { LaserWriter Reference, p. 32 }
  77.         var
  78.             styleCode: Integer;
  79.     begin
  80.         styleCode := 0;
  81.         if bold in aStyle then
  82.             styleCode := styleCode + 1;
  83.         if italic in aStyle then
  84.             styleCode := styleCode + 2;
  85.         if outline in aStyle then
  86.             styleCode := styleCode + 4;
  87.         if shadow in aStyle then
  88.             styleCode := styleCode + 8;
  89.         if condense in aStyle then
  90.             styleCode := styleCode + 16;
  91.         if extend in aStyle then
  92.             styleCode := styleCode + 32;
  93.         CompressStyle := styleCode;  { values 0..47 only: condense/extend mutually exclusive }
  94.     end;
  95.  
  96.  
  97. {------------------------------------------------}
  98.     function BuildPSFontName (id: Integer; aStyle: Style): Str255;
  99.         label
  100.             99;
  101.         type
  102.             IntegerPtr = ^Integer;
  103.             FamRecPtr = ^FamRec;
  104.             StylMapTable = record  { see LaserWriter Reference p. 28 }
  105.                     class: Integer;
  106.                     offset: Longint;
  107.                     reserved: Longint;
  108.                     suffixIndex: packed array[0..47] of SignedByte;
  109.                 end;
  110.             StylMapPtr = ^StylMapTable;
  111.         var
  112.             h: Handle;
  113.             p: FamRecPtr;
  114.             offSet: Integer;
  115.             smp: StylMapPtr;
  116.             q: Ptr;  { pointer to Style-name table: not a good Pascal structure ...}
  117.             nbOfStrings: Integer;  { not used }
  118.             PSName, suffixIndices: Str255;
  119.             i, whichIndex: Integer;
  120.  
  121.         function NthStyleName (index: Integer; q: Ptr): Str255;
  122. { index 1 => basename, pointed to by q }
  123. { cf.  d e v e l o p  Summer 91, p. 100 ! }
  124.             var
  125.                 s: Str255;
  126.         begin
  127.             if (index > 1) and (index <= nbOfStrings) then
  128.                 begin
  129.                     while index > 1 do
  130.                         begin
  131.                             q := Ptr(ord4(q) + q^ + 1);  { assumes q^ = stringlength < 128 ...}
  132.                             index := index - 1;
  133.                         end;
  134.                     BlockMove(q, @s[0], q^ + 1); { assumes q^ = stringlength < 127 ...}
  135.                     NthStyleName := s;
  136.                 end
  137.             else  { FOND corrupted !}
  138.                 NthStyleName := '???';
  139.         end;
  140.  
  141.     begin  {BuildPSFontName}
  142.         PSName := '';
  143.         TextFace(aStyle);
  144.         h := GetResource('FOND', id);
  145.         if h = nil then
  146.             goto 99;  { a reminiscence of AppleSoft }
  147.         HLock(h);
  148.         p := FamRecPtr(h^);
  149.         offSet := p^.ffStylOff;
  150.         if offSet = 0 then  { no style-mapping table }
  151.             goto 99;  { again ?! }
  152.         smp := StylMapPtr(ord4(p) + offSet);
  153.         q := Ptr(ord4(smp) + SizeOf(StylMapTable));  { style-name table follows style-mappingTable}
  154.         nbOfStrings := IntegerPtr(q)^;   { for range checking in "NthStyleName" above }
  155.         q := Ptr(ord4(q) + 2); { now pointing to basename of font }
  156.         BlockMove(q, @PSName, q^ + 1);  { basename of font; assumes length < 128 }
  157.         whichIndex := smp^.suffixIndex[CompressStyle(aStyle)];
  158.         if whichIndex > 1 then
  159.             begin
  160.                 suffixIndices := NthStyleName(whichIndex, q);
  161.                 for i := 1 to ord(suffixIndices[0]) do
  162.                     PSName := concat(PSName, NthStyleName(ord(suffixIndices[i]), q));
  163.             end;
  164.         HUnlock(h);
  165. 99:
  166.         BuildPSFontName := PSName;
  167.     end;  {BuildPSFontName}
  168.  
  169.  
  170. {------------------------------------------------}
  171.     procedure Test;
  172.         var
  173.             fontName: Str255;
  174.             familyID: Integer;
  175.             aStyle: Style;
  176.     begin
  177.         fontName := 'Times';
  178.         GetFNum(fontName, familyID);
  179.         TextFont(familyID);
  180.         TextSize(36);
  181.  
  182.         aStyle := [];  { plain }
  183.         MoveTo(30, 60);
  184.         DrawString(BuildPSFontName(familyID, aStyle));
  185.  
  186.         aStyle := [bold];
  187.         MoveTo(30, 120);
  188.         DrawString(BuildPSFontName(familyID, aStyle));
  189.  
  190.         aStyle := [italic];
  191.         MoveTo(30, 180);
  192.         DrawString(BuildPSFontName(familyID, aStyle));
  193.  
  194.         aStyle := [bold, italic];
  195.         MoveTo(30, 240);
  196.         DrawString(BuildPSFontName(familyID, aStyle));
  197.     end;
  198.  
  199. {------------------------------------------------}
  200. begin
  201.     InitMac;
  202.     InitApp;
  203.     Test;
  204.     WaitForButton;
  205. end.
  206. {------------------------------------------------}